/* GUI CONVERTED from rsshmtb.p (converter v1.76) Fri Aug 23 22:30:02 2002 */
/* rsshmtb.p - Release Management Supplier Schedules                          */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                        */
/* All rights reserved worldwide.  This is an unpublished work.               */
/* $Revision: 1.16.3.29 $                                                     */
/*V8:ConvertMode=Maintenance                                                  */
/* REVISION: 7.3    LAST MODIFIED: 10/12/92           BY: WUG *G462*          */
/* REVISION: 7.3    LAST MODIFIED: 02/18/83           BY: WUG *G695*          */
/* REVISION: 7.3    LAST MODIFIED: 03/26/93           BY: WUG *G878*          */
/* REVISION: 7.3    LAST MODIFIED: 03/29/93           BY: WUG *G880*          */
/* REVISION: 7.3    LAST MODIFIED: 05/24/93           BY: WUG *GB29*          */
/* REVISION: 7.3    LAST MODIFIED: 06/10/93           BY: WUG *GB99*          */
/* REVISION: 7.3    LAST MODIFIED: 07/27/93           BY: WUG *GD77*          */
/* REVISION: 7.3    LAST MODIFIED: 09/20/93           BY: WUG *GF65*          */
/* REVISION: 7.3    LAST MODIFIED: 10/25/93           BY: WUG *GG66*          */
/* REVISION: 7.3    LAST MODIFIED: 12/23/93           BY: WUG *GI31*          */
/* REVISION: 7.4    LAST MODIFIED: 01/05/94           BY: dpm *H074*          */
/* REVISION: 7.3    LAST MODIFIED: 04/14/94           BY: WUG *GJ37*          */
/* REVISION: 7.4    LAST MODIFIED: 09/15/94           by: slm *GM62*          */
/* REVISION: 7.4    LAST MODIFIED: 10/23/94           by: dpm *GN52*          */
/* REVISION: 7.4    LAST MODIFIED: 11/01/94           BY: ame *GN88*          */
/* REVISION: 7.3    LAST MODIFIED: 11/09/94           BY: WUG *GN76*          */
/* REVISION: 7.3    LAST MODIFIED: 11/10/94           BY: WUG *GO39*          */
/* REVISION: 8.5    LAST MODIFIED: 11/29/94           BY: mwd *J034*          */
/* REVISION: 8.5    LAST MODIFIED: 12/09/94           by: taf *J038*          */
/* REVISION: 7.3    LAST MODIFIED: 12/23/94           BY: bcm *G09Z*          */
/* REVISION: 8.5    LAST MODIFIED: 01/03/95           by: ktn *J041*          */
/* REVISION: 8.5    LAST MODIFIED: 01/15/95           by: pma *J040*          */
/* REVISION: 7.3    LAST MODIFIED: 03/03/95           BY: WUG *G0G2*          */
/* REVISION: 7.3    LAST MODIFIED: 03/06/95           BY: jxz *G0GG*          */
/* REVISION: 7.3    LAST MODIFIED: 03/29/95           BY: dzn *F0PN*          */
/* REVISION: 8.5    LAST MODIFIED: 04/26/95           by: sxb *J04D*          */
/* REVISION: 7.4    LAST MODIFIED: 02/17/95           BY: vrn *G0TN*          */
/* REVISION: 8.5    LAST MODIFIED: 03/21/96           BY: vrn *G1NV*          */
/* REVISION: 8.5    LAST MODIFIED: 06/05/96           BY: rxm *G1XG*          */
/* REVISION: 8.5    LAST MODIFIED: 08/21/96   BY: *G1QH* Aruna P.Patil        */
/* REVISION: 8.5    LAST MODIFIED: 11/04/96   BY: *H0NW* Suresh Nayak         */
/* REVISION: 8.5    LAST MODIFIED: 11/08/96   BY: *H0NL* Suresh Nayak         */
/* REVISION: 8.6    LAST MODIFIED: 11/22/96   BY: *K022* Kieu Nguyen          */
/* REVISION: 8.6    LAST MODIFIED: 02/05/97   BY: *K05S* Kieu Nguyen          */
/* REVISION: 8.6    LAST MODIFIED: 06/02/97   BY: *K0F2* Arul Victoria        */
/* REVISION: 8.6    LAST MODIFIED: 11/11/97   BY: *K18W* Suresh Nayak         */
/* REVISION: 8.6    LAST MODIFIED: 12/02/97   BY: *J274* Seema Varma          */
/* REVISION: 8.6E   LAST MODIFIED: 02/23/98   BY: *L007* Annasaheb Rahane     */
/* REVISION: 8.6E   LAST MODIFIED: 05/09/98   BY: *L00Y* Jeff Wootton         */
/* REVISION: 8.6E   LAST MODIFIED: 06/11/98   BY: *L020* Charles Yen          */
/* REVISION: 8.6E   LAST MODIFIED: 08/18/98   BY: *K1WD* Poonam Bahl          */
/* REVISION: 9.0    LAST MODIFIED: 06/02/99   BY: *J3GM* Kedar Deherkar       */
/* REVISION: 9.1    LAST MODIFIED: 09/24/99   BY: *L0JD* Reetu Kapoor         */
/* REVISION: 9.1    LAST MODIFIED: 10/25/99   BY: *N002* Bill Gates           */
/* REVISION: 9.1    LAST MODIFIED: 03/24/00   BY: *N08T* Annasaheb Rahane     */
/* REVISION: 9.1    LAST MODIFIED: 06/20/00   BY: *L0ZK* Sachin Shinde        */
/* REVISION: 9.1    LAST MODIFIED: 07/17/00   BY: *M0PQ* Falguni Dalal        */
/* REVISION: 9.1    LAST MODIFIED: 08/12/00   BY: *N0KP* Mark Brown           */
/* REVISION: 9.1    LAST MODIFIED: 09/08/00   BY: *L13W* Abhijeet Thakur      */
/* REVISION: 9.1    LAST MODIFIED: 12/28/00   BY: *L13Y* Kaustubh K.          */
/* REVISION: 9.1    LAST MODIFIED: 01/24/01   BY: *L14B* Satish Chavan        */
/* Revision: 1.16.3.15     BY: Ashwini Ghaisas    DATE: 12/07/01  ECO: *M16H* */
/* Revision: 1.16.3.16     BY: Rajiv Ramaiah      DATE: 04/22/02  ECO: *N1H0* */
/* Revision: 1.16.3.19     BY: Ashish Maheshwari  DATE: 05/07/02  ECO: *M1Y6* */
/* Revision: 1.16.3.22     BY: Tiziana Giustozzi  DATE: 05/24/02  ECO: *P03Z* */
/* Revision: 1.16.3.24     BY: Tiziana Giustozzi  DATE: 06/17/02  ECO: *P08H* */
/* Revision: 1.16.3.25     BY: Ashish Maheshwari  DATE: 07/17/02  ECO: *N1GJ* */
/* Revision: 1.16.3.26     BY: Robin McCarthy     DATE: 07/19/02  ECO: *P0BJ* */
/* $Revision: 1.16.3.29 $  BY: Gnanasekar         DATE: 08/19/02  ECO: *M202* */

/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/

/* SHIPPER MAINT SUBPROGRAM                                             */
/* Maintain list of contained items                                     */
/* REPLACED qty_ratio WITH part_qty / part2_qty                         */

{mfdeclre.i}
{gplabel.i} /* EXTERNAL LABEL INCLUDE */

define input parameter abs_recid as recid.

define new shared variable qad_wkfl_id as character.
define new shared variable multi_entry like mfc_logical no-undo
   label "Multi Entry".
define new shared variable cline as character.
define new shared variable lotserial_control like pt_lot_ser.
define new shared variable issue_or_receipt as character.
define new shared variable total_lotserial_qty like sr_qty.
define new shared variable site like sr_site no-undo.
define new shared variable location like sr_loc no-undo.
define new shared variable lotserial like sr_lotser no-undo.
define new shared variable lotserial_qty like sr_qty no-undo.
define new shared variable trans_um like pt_um.
define new shared variable trans_conv like pod_um_conv.
define new shared variable transtype as character initial "rct-po".
define new shared variable lotref like sr_ref no-undo.
define new shared variable loc like pt_loc.
define new shared variable change_db like mfc_logical.
define new shared variable msgref as character format "x(20)".
define new shared variable stat_recno as recid.
define new shared variable global_order as character.
define new shared variable eff_date as date.
define new shared variable global_recid as recid.
define new shared variable s_abs_recid as recid no-undo.
define new shared variable undo_blk as logical no-undo.

define variable deassign like mfc_logical.
define variable del-yn like mfc_logical.
define variable i as integer.
define variable sr_item like pt_part.
define variable old_gwt like pt_net_wt.
define variable new_gwt like pt_net_wt.
define variable old_nwt like pt_net_wt.
define variable new_nwt like pt_net_wt.
define variable old_vol like abs_vol.
define variable new_vol like abs_vol.
define variable wt_conv as decimal.
define variable vol_conv as decimal.
define variable ship_db as character.
define variable yn like mfc_logical.
define variable scheduled_orders_exist like mfc_logical.
define variable lotop as character.
define variable msg_ct as integer.
define variable undo_stat as log no-undo.
define variable lotnext like wo_lot_next.
define variable lotprcpt like wo_lot_rcpt no-undo.
define variable trans-ok like mfc_logical no-undo.
define variable process_type as integer no-undo initial 1.
define variable qty_ratio as decimal no-undo.
define variable part_qty  as decimal no-undo.
define variable total_received like pod_qty_rcvd.
define variable base_amt like pod_pur_cost.
define variable exch_rate like exr_rate.
define variable exch_rate2 like exr_rate.
define variable dummy_logi as logical no-undo.
define variable mc-error-number like msg_nbr no-undo.
define variable dir-ship as logical no-undo.
define variable stage_open like mfc_logical no-undo.
define variable l_old_db   like global_db   no-undo.
define variable l_err-flag as   integer     no-undo.
define variable mod_iss        like mfc_logical label "Receive Components"
                               initial yes no-undo.
define variable l_modiss_lbl   like mfc_char format "x(20)"
                                                      no-undo.
define variable part           like pt_part           no-undo.
define variable l_id           like abs_id            no-undo.
define variable l_shipfrom     like abs_shipfrom      no-undo.
define variable tmp_prefix     as character           no-undo.
define variable l_sod_nbr      like sod_nbr           no-undo.
define variable l_sod_line     like sod_line          no-undo.
define variable l_sr_qty       like sr_qty            no-undo.
define variable l_abs_shipfrom like abs_shipfrom      no-undo.
define variable l_abs_id       like abs_id            no-undo.
define variable tempstr        as character           no-undo.
define variable inputq_op      as integer.
define variable inputq_qty_chg as decimal.
define variable use-log-acctg  as logical             no-undo.
define variable undo-retry as logical                 no-undo.

define buffer abs_mstr_item for abs_mstr.
define buffer abs_comp for abs_mstr.
define buffer abs_buff for abs_mstr.
define buffer ship_line for abs_mstr.
define buffer prev_wr_route for wr_route.

define workfile uom_abs
   field uom_nbr     like pod_nbr
   field uom_line    like pod_line
   field uom_part    like pt_part
   field uom_um      like pod_um
   field uom_um_conv like pod_um_conv.

define new shared frame a.

define shared variable h_wiplottrace_procs as handle no-undo.
define shared variable h_wiplottrace_funcs as handle no-undo.
{wlfnc.i} /* FUNCTION FORWARD DECLARATIONS */
{wlcon.i} /* CONSTANTS DEFINITIONS         */

issue_or_receipt = getTermLabel("RECEIPT",10).
{soabsdef.i new}

l_modiss_lbl = getTermLabelRtColon("RECEIVE_COMPONENTS",20).


/*GUI preprocessor Frame A define */
&SCOPED-DEFINE PP_FRAME_NAME A

FORM /*GUI*/ 
   
 RECT-FRAME       AT ROW 1.4 COLUMN 1.25
 RECT-FRAME-LABEL AT ROW 1   COLUMN 3 NO-LABEL
 SKIP(.1)  /*GUI*/
scx_part             colon 20 label "Item"
   pt_desc1             at 46 no-label no-attr-space format "x(23)"
   scx_po               colon 20 format "x(8)"
   scx_line
   skip(1)
   sr_qty               colon 20
   trans_um
   trans_conv           colon 51 label "Conv"
   sr_site              colon 20
   sr_loc               colon 20
   sr_lotser            colon 20
   sr_ref               colon 20
   multi_entry          colon 20
 SKIP(.4)  /*GUI*/
with frame a side-labels width 80 attr-space
    NO-BOX THREE-D /*GUI*/.

 DEFINE VARIABLE F-a-title AS CHARACTER.
 F-a-title = (getFrameTitle("CONTENTS_(ITEMS)",24)).
 RECT-FRAME-LABEL:SCREEN-VALUE in frame a = F-a-title.
 RECT-FRAME-LABEL:WIDTH-PIXELS in frame a =
  FONT-TABLE:GET-TEXT-WIDTH-PIXELS(
  RECT-FRAME-LABEL:SCREEN-VALUE in frame a + " ", RECT-FRAME-LABEL:FONT).
 RECT-FRAME:HEIGHT-PIXELS in frame a =
  FRAME a:HEIGHT-PIXELS - RECT-FRAME:Y in frame a - 2.
 RECT-FRAME:WIDTH-CHARS IN FRAME a = FRAME a:WIDTH-CHARS - .5. /*GUI*/

/*GUI preprocessor Frame A undefine */
&UNDEFINE PP_FRAME_NAME



/* SET EXTERNAL LABELS */
setFrameLabels(frame a:handle).

FORM /*GUI*/ 
   
 RECT-FRAME       AT ROW 1 COLUMN 1.25
 RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL VIEW-AS TEXT SIZE-PIXELS 1 BY 1
 SKIP(.1)  /*GUI*/
space(1)
   l_modiss_lbl format "x(20)"
   mod_iss
   space(2)
    SKIP(.4)  /*GUI*/
with frame e no-labels overlay attr-space centered  row 11 NO-BOX THREE-D /*GUI*/.

 DEFINE VARIABLE F-e-title AS CHARACTER INITIAL "".
 RECT-FRAME-LABEL:SCREEN-VALUE in frame e = F-e-title.
 RECT-FRAME-LABEL:HIDDEN in frame e = yes.
 RECT-FRAME:HEIGHT-PIXELS in frame e =
  FRAME e:HEIGHT-PIXELS - RECT-FRAME:Y in frame e - 2.
 RECT-FRAME:WIDTH-CHARS IN FRAME e = FRAME e:WIDTH-CHARS - .5.  /*GUI*/


qad_wkfl_id = mfguser + "rsshmtb.p".

find first clc_ctrl no-lock no-error.
if not available clc_ctrl
then do:
   {gprun.i ""gpclccrt.p""}
/*GUI*/ if global-beam-me-up then undo, leave.

   find first clc_ctrl no-lock.
end.

/* VALIDATE IF LOGISTICS ACCOUNTING IS TURNED ON */
{gprun.i ""lactrl.p"" "(output use-log-acctg)"}
/*GUI*/ if global-beam-me-up then undo, leave.


find abs_mstr where recid(abs_mstr) = abs_recid no-lock.
s_abs_recid = abs_recid.

find first poc_ctrl no-lock no-error.

find ad_mstr where ad_addr = abs_shipfrom no-lock.

mainloop:
repeat for abs_mstr_item:
   for each sr_wkfl exclusive-lock where sr_userid = mfguser:
      delete sr_wkfl.
   end.

   for each qad_wkfl exclusive-lock
      where qad_key1 = mfguser + "rsshmtb.p":
      delete qad_wkfl.
   end.

   for each uom_abs exclusive-lock:
      delete uom_abs.
   end.

   for each abs_mstr_item no-lock
      where abs_shipfrom = abs_mstr.abs_shipfrom
        and abs_par_id = abs_mstr.abs_id
        and abs_id begins "i",
      each pod_det no-lock
      where pod_nbr = abs_order
        and pod_line = integer(abs_line)
      break by pod_nbr by pod_line:

      if first-of(pod_line)
      then do:
         create qad_wkfl.

         assign
            qad_key1        = qad_wkfl_id
            qad_key2        = string(pod_part,"x(18)") + string(pod_nbr,"x(8)")
                                                + string(pod_line,"9999")
            qad_key3        = qad_wkfl_id
            qad_key4        = string(pod_nbr,"x(8)") + string(pod_line,"9999")
            qad_charfld[1]  = pod_part
            qad_charfld[2]  = pod_nbr
            qad_charfld[3]  = pod_nbr
            qad_decfld[1]   = pod_line.
         if recid(qad_wkfl) = -1
         then .

         find first uom_abs
            where uom_nbr  = pod_nbr
              and uom_line = pod_line
              and uom_part = pod_part no-error.

         if not available uom_abs
         then do:
            create uom_abs .
            assign
               uom_nbr     = pod_nbr
               uom_line    = pod_line
               uom_part    = pod_part
               uom_um      = abs_mstr_item.abs__qad02
               uom_um_conv = decimal(abs_mstr_item.abs__qad03).
         end. /* IF NOT AVAILABLE uom_abs .. */

      end. /* if first pod_line .. */
   end. /* for each abs_mstr */

   /* RESET RECORD POINTER */
   for first abs_mstr where recid(abs_mstr) = abs_recid no-lock:
   end.

   undo_blk = no.
   {gprun.i ""rsshmtp.p""}
/*GUI*/ if global-beam-me-up then undo, leave.

   if undo_blk = yes
   then
      undo, leave.

   find po_mstr where po_nbr = input scx_po no-lock no-error.

   if not available po_mstr
   then do:
      /* Purchase Order does not exist */
      {pxmsg.i &MSGNUM=343 &ERRORLEVEL=3}
      undo, retry.
   end.
   else do:
      if po_vend <> abs_mstr.abs_shipfrom
      then do:
         /* Order not for this supplier */
         {pxmsg.i &MSGNUM=8201 &ERRORLEVEL=3}
         undo, retry.
      end.

      if po_type = "B"
      then do:
         /* BLANKET ORDER NOT ALLOWED */
         {pxmsg.i &MSGNUM=385 &ERRORLEVEL=3}
         undo, retry.
      end. /* if po_type = "B" ..*/
   end. /* else do */

   if use-log-acctg
   then do:

      {gprunmo.i &module  = "LA" &program = "lashmtb.p"
                 &param   = """(input abs_recid,
                                input (input scx_po),
                                input abs_mstr.abs_shipfrom,
                                output undo-retry)"""}

      if undo-retry
      then
         undo mainloop, retry mainloop.

   end. /* if use-log-acctg */

   /* HANDLING OF SCHEDULED/NONSCHEDULED ORDERS */
   find pod_det where pod_nbr  = po_nbr
      and pod_line = input scx_line
   no-lock no-error.

   if not available pod_det
   then do:
      i = 0.

      for each pod_det no-lock
         where pod_part = input scx_part
           and pod_nbr  = po_nbr:
         i = i + 1.
      end. /* for each pod_det */

      if i > 1
      then do:
         /* More than one order line found */
         {pxmsg.i &MSGNUM=8247 &ERRORLEVEL=3}
         undo, retry.
      end. /* if i > 1 */
      else
      if i = 1
      then
         find first pod_det where pod_part = input scx_part
                            and   pod_nbr  = po_nbr
         no-lock.
   end. /* IF AVAILABLE pod_det .. */

   if not available pod_det
   then do:
      /* Line item does not exist */
      {pxmsg.i &MSGNUM=45 &ERRORLEVEL=3}
      undo, retry.
   end. /* IF NOT AVAILABLE pod_det .. */

   /* TO CHECK IF CENTRAL DATABASE IS CONNECTED */
   if  global_db <> ""
   and not connected(pod_po_db)
   then do:
      /* ERROR: DATABASE NOT AVAILABLE */
      {pxmsg.i &MSGNUM=2510 &ERRORLEVEL=3
               &MSGARG1=pod_po_db}
     undo,retry.
   end. /* IF GLOBAL_DB <> "" */

   /* INTRODUCING A TRANSACTION SO THAT THE LOCKS ON PO_MSTR */
   /* AND POD_DET GET RELEASED.                              */

   do transaction:
/*GUI*/ if global-beam-me-up then undo, leave.

      find po_mstr
         where po_nbr = input scx_po exclusive-lock.

      find pod_det
         where pod_nbr  = po_nbr
         and pod_line = input scx_line
      exclusive-lock.

      if available pod_det
         and       pod_status <> ""
      then do:
         yn = no.
         /* PO AND/OR PO LINE CLOSED - REOPEN? */
         {pxmsg.i &MSGNUM=339 &ERRORLEVEL=1 &CONFIRM=yn}
         if yn = yes
         then do:
            l_old_db = global_db.

            /* SWITCHING TO CENTRAL DB */
            if global_db <> pod_po_db
            then do:
               {gprun.i ""gpalias3.p""
                  "(pod_po_db,
                    output l_err-flag)"}
/*GUI*/ if global-beam-me-up then undo, leave.

            end. /* IF GLOBAL_DB <> POD_PO_DB THEN */

            /* RE-OPEN PO IN CENTRAL DATABASE */

            {gprun.i ""rspostat.p""
               "(input po_nbr,
                 input pod_line)"}
/*GUI*/ if global-beam-me-up then undo, leave.


            /* SWITCHING BACK TO REMOTE DB */
            if l_old_db <> global_db
            then do:
               {gprun.i ""gpalias3.p""
                  "(l_old_db,
                    output l_err-flag)"}
/*GUI*/ if global-beam-me-up then undo, leave.

            end. /* IF l_old_db <> global_db */

            assign
               pod_status  = ""
               po_stat     = ""
               po_cls_date = ?.

         end. /* IF YN = YES */
         else do:
            next-prompt scx_po with frame a.
            undo mainloop,retry mainloop.
         end. /* ELSE DO */
      end. /* IF AVAILABLE POD_DET ... */
   end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* DO TRANSACTION */

   if pod_site <> abs_mstr.abs_shipto
   then do:
      /* PO not for this ship-to site */
      {pxmsg.i &MSGNUM=8202 &ERRORLEVEL=3}
      undo, retry.
   end.

   find first sod_det where
      sod_nbr          = po_so_nbr and
      sod_btb_po       = po_nbr and
      sod_btb_pod_line = pod_sod_line
   no-lock no-error.

   if available sod_det
      and sod_btb_type = "03"
   then
      assign
         dir-ship    = yes
         multi_entry = no.

   /* DISABLE MULTI-ENTRY WHEN KIT PARENT */
   if available sod_det
      and sod_cfg_type = "2"
   then
      multi_entry = no.

   find pt_mstr where pt_part = pod_part no-lock no-error.

   display
      pod_part @ scx_part
      pt_desc1 when (available pt_mstr)
      pod_nbr @ scx_po
      pod_line @ scx_line
   with frame a.

   find po_mstr where po_nbr = pod_nbr no-lock.

   if pod_site <> abs_mstr.abs_shipto
   then do:
      /* Invalid order ship-to site */
      {pxmsg.i &MSGNUM=8233 &ERRORLEVEL=3 &MSGARG1=pod_site}
      undo, retry.
   end. /* if pod_site <> .. */

   /* PICK UP CURRENTLY EFFECTIVE CUM ORDER */
   eff_date = today.
   {gprun.i ""poporca5.p""
      "(input pod_nbr,
        input pod_line,
        input eff_date)"}
/*GUI*/ if global-beam-me-up then undo, leave.


   if    pod_start_eff[1] > today
      or pod_end_eff[1] < today
   then do:
      /* Scheduled Order is no longer effective */
      {pxmsg.i &MSGNUM=8204 &ERRORLEVEL=2}
   end. /* if pod_start_eff[1] .. */

   if is_wiplottrace_enabled()
   then do:
      for first wr_route
         where wr_lot = pod_wo_lot
         and wr_op = pod_op
      no-lock:
         if is_operation_queue_lot_controlled
            (pod_wo_lot, pod_op, INPUT_QUEUE)
         then do:
            tempstr = pod_nbr + '/' + string(pod_line).
            /*PO line is WIP lot traced, use PO Receipts*/
            {pxmsg.i &MSGNUM=8462 &ERRORLEVEL=3 &MSGARG1=tempstr}
            undo mainloop, retry mainloop.
         end. /* if is_operation_queue .. */
      end. /* for first wr_route */
   end. /* if is_wiplottrace .. */

   if pod_cum_qty[1] >= pod_cum_qty[3]
      and pod_cum_qty[3] > 0
   then do:
      /* Cum received qty >= Max order qty for order selected */
      {pxmsg.i &MSGNUM=8232 &ERRORLEVEL=2}
   end. /* if pod_cum_qty[1] .. */

   if pod_sched and
      pod_curr_rlse_id[1] = ""
   then do:
      /* NO ACTIVE SCHEDULE EXISTS */
      {pxmsg.i &MSGNUM=2362 &ERRORLEVEL=2}
   end. /* IF pod_sched */

   find first uom_abs where uom_nbr = pod_nbr
      and  uom_line = pod_line
      and  uom_part = pod_part no-error.
   if not available uom_abs
   then do:
      create uom_abs .
      assign
         uom_nbr     = pod_nbr
         uom_line    = pod_line
         uom_part    = pod_part
         uom_um      = pod_um.
         uom_um_conv = pod_um_conv.
   end. /* if not available .. */

   if available uom_abs
   then
      assign
         trans_um   = uom_um
         trans_conv = uom_um_conv.

   assign
      i = 0
      total_lotserial_qty = 0.

   if trans_um = ""
   then
      trans_um = pod_um.

   if trans_conv = 0
   then
      trans_conv = pod_um_conv.

   for each abs_mstr_item no-lock
      where abs_shipfrom = abs_mstr.abs_shipfrom
        and abs_par_id   = abs_mstr.abs_id
        and abs_id       begins "i"
        and abs_order    = pod_nbr
        and abs_line     = string(pod_line):

      /* SKIP CREATION OF sr_wkfl IF ITEM IS A COMPONENT ITEM */
      if can-find (sob_det
                    where sob_nbr  = po_so_nbr
                      and sob_part = abs_item )
      then next .

      create sr_wkfl.

      assign
         sr_userid  = mfguser
         sr_site    = abs_site
         sr_loc     = abs_loc
         sr_lotser  = abs_lotser
         sr_ref     = abs_ref
         sr_qty     = abs_qty
         trans_um   = abs__qad02
         trans_conv = decimal(abs__qad03) .

      if recid(sr_wkfl) = -1
      then .

      assign
         i = i + 1
         total_lotserial_qty = total_lotserial_qty + sr_qty.
   end. /* for each abs_mstr_itm */

   if dir-ship
   then
      find first soc_ctrl no-lock no-error.

   multi_entry = no.
   if i > 1
   then do:
      multi_entry = yes.

      if available sod_det
         and sod_cfg_type = "2"
      then
         multi_entry = no.

      display
         trans_um
         trans_conv
         abs_mstr.abs_shipto @ sr_site
         abs_mstr.abs_loc @ sr_loc
         "" @ sr_lotser
         "" @ sr_ref
         "" @ sr_qty
         multi_entry
      with frame a.
   end.  /* if i > 0 */
   else
   if i = 1
   then do:
      find first sr_wkfl where sr_userid = mfguser no-lock.

      display
         trans_um
         trans_conv
         sr_site
         sr_lotser
         sr_ref
         sr_qty
         multi_entry
      with frame a.
      if dir-ship
      then
         display
            soc_dum_loc @ sr_loc with frame a.
      else
         display sr_loc with frame a.

   end.
   else do:

      display
         trans_um
         trans_conv
         abs_mstr.abs_shipto @ sr_site
         "" @ sr_lotser
         "" @ sr_ref
         "" @ sr_qty
         multi_entry
      with frame a.

      if dir-ship
      then
         display soc_dum_loc @ sr_loc with frame a.
      else
         display pod_loc @ sr_loc with frame a.
   end. /* ELSE DO */

   ststatus = stline[3].
   status input ststatus.

   /* DISABLE MULTI-ENTRY WHEN KIT PARENT */
   if available sod_det
      and sod_cfg_type = "2"
   then do:
     multi_entry = no.
     display multi_entry with frame a.
   end. /* IF AVAILABLE sod_det AND sod_cfg_type = "2" */

   do with frame a:
      prompt-for
         sr_qty
         trans_um
         trans_conv
         sr_site
         sr_loc when (not dir-ship)
         sr_lotser
         sr_ref
         multi_entry
            when (not available sod_det
                  or (available sod_det
                      and sod_cfg_type <> "2"))

      editing:
         assign
            global_part = pod_part
            global_site = input sr_site
            global_loc  = input sr_loc
            global_lot  = input sr_lotser.

         readkey.
         apply lastkey.
      end. /* prompt-for .. */

      for first pt_mstr
         fields(pt_desc1 pt_lot_ser pt_part pt_um)
         where pt_part = pod_part no-lock:
      end. /* FOR FIRST pt_mstr */

      assign
         multi_entry
         cline             = ""
         site              = input sr_site
         location          = input sr_loc
         lotserial         = input sr_lotser
         lotserial_qty     = input sr_qty
         trans_um          = uom_um
         trans_conv
         lotref            = input sr_ref
         lotserial_control = if available pt_mstr
                             then
                                pt_lot_ser
                             else ""
         global_part       = pod_part
         trans_um
         trans_conv.

      {gprun.i ""gpsiver.p""
         "(input (input sr_site),
           input ?,
           output return_int)"}
/*GUI*/ if global-beam-me-up then undo, leave.


      if return_int = 0
      then do:
         /* USER DOES NOT HAVE ACCESS TO SITE */
         {pxmsg.i &MSGNUM=725 &ERRORLEVEL=3}
         undo, retry.
      end. /* if return_int .. */

      if available pt_mstr
      then do:

         if trans_conv = 1
            and trans_um <> pt_um
         then do:
            {gprun.i ""gpumcnv.p""
               "(input trans_um,
                 input pt_um,
                 input pt_part,
                 output trans_conv)"}
/*GUI*/ if global-beam-me-up then undo, leave.


            if trans_conv = ?
            then do:
               /* No unit of measure conversion exists */
               {pxmsg.i &MSGNUM=33 &ERRORLEVEL=2}
               trans_conv = 1.
            end. /* if trans_conv ... */

            display trans_conv with frame a.
         end.
      end. /* IF AVAILABLE pt_mstr */
      else do:
         trans_conv = 1.
         display trans_conv with frame a.
      end. /* ELSE DO */

      /* If specified site is not defined ship-from site, */
      /* Make sure it's in the same database              */

      if site <> abs_mstr.abs_shipto
      then do:
         find si_mstr where si_site = abs_mstr.abs_shipto no-lock.
         ship_db = si_db.
         find si_mstr where si_site = site no-lock.
         if si_db <> ship_db
         then do:
            /* All ship-to sites must be in the same database */
            {pxmsg.i &MSGNUM=8205 &ERRORLEVEL=3}
            next-prompt sr_site.
            undo, retry.
         end.
      end. /* if site <> abs_mstr .. */

      if use-log-acctg
      then do:

         {gprunmo.i &module  = "LA" &program = "lashmtb1.p"
                    &param   = """(input abs_recid,
                                   input abs_mstr.abs_shipfrom,
                                   input (input scx_po))"""}
      end.

      if    i > 1
         or multi_entry
      then do:
         assign
            lotnext  = ""
            lotprcpt = no.

         /* ADDED SIXTH INPUT PARAMETER dir-ship TO  */
         /* INDICATE THAT THE ORDER TYPE IS DIR-SHIP */
         {gprun.i ""icsrup.p""
            "(input abs_mstr.abs_shipto,
              input pod_nbr,
              input string(pod_line),
              input-output lotnext,
              input lotprcpt,
              input dir-ship)"}
/*GUI*/ if global-beam-me-up then undo, leave.

      end. /* if i > 1 .. */
      else do transaction:
/*GUI*/ if global-beam-me-up then undo, leave.


         /* FOLLOWING CODE IN THIS BLOCK LIFTED FROM POPORCA.P */
         /*CREATE LD_DET RECORD IF ASSAY, ETC HAS BEEN CHANGED*/
         /*OR THERE IS AN ITEM DEFINED STATUS FOR THIS ITEM   */

         /* DO NOT CREATE ld_det RECORD IF THE LINE ITEM IS A KIT PARENT */
         if not can-find (sod_det
                            where sod_nbr      = po_so_nbr
                              and sod_line     = pod_sod_line
                              and sod_cfg_type = "2"
                              and sod_part     = global_part
                              and sod_fa_nbr   = ""  )
         then do:

            if pod_type = ""
            then do:

               eff_date = today.
               {gprun.i ""poporca1.p"" "(input recid(pod_det))"}
/*GUI*/ if global-beam-me-up then undo, leave.


               if msgref <> ""
               then do:
                  msgref = trim(msgref).
                  /* # CONFLICTS WITH EXISTING INVENTORY DETAIL */
                  {pxmsg.i &MSGNUM=1914 &ERRORLEVEL=3
                           &MSGARG1=msgref}
                  undo mainloop, retry mainloop.
               end. /* if msgref <> .. */

               /* DOES STATUS ALLOW RECEIPT AT POD SITE */

              {gprun.i ""icedit.p""
                  "(input ""RCT-PO"",
                    input site,
                    input location,
                    input global_part,
                    input lotserial,
                    input lotref,
                    input lotserial_qty * trans_conv,
                    input trans_um,
                    input pod_nbr,
                    input string(pod_line),
                    output yn )"
                  }
/*GUI*/ if global-beam-me-up then undo, leave.

               if yn
               then
                  undo, retry.

            end. /* IF pod_type = "" */

            if pod_site <> site
               and pod_type = ""
            then do:
               /* DOES STATUS ALLOW RECEIPT AT POD SITE */
               {gprun.i ""icedit3.p""
                  "(input ""RCT-PO"",
                    input pod_site,
                    input location,
                    input global_part,
                    input lotserial,
                    input lotref,
                    input lotserial_qty * trans_conv,
                    input trans_um,
                    input pod_nbr,
                    input string(pod_line),
                    output yn)"
                  }
/*GUI*/ if global-beam-me-up then undo, leave.

              if yn
              then
                 undo, retry.

              /* DOES STATUS ALLOW TRANSFER OUT OF RECEIPT SITE */
              {gprun.i ""icedit3.p""
                  "(input ""ISS-TR"",
                    input pod_site,
                    input location,
                    input global_part,
                    input lotserial,
                    input lotref,
                    input lotserial_qty
                    * trans_conv,
                    input trans_um,
                    input """",
                    input """",
                    output yn)"
                  }
/*GUI*/ if global-beam-me-up then undo, leave.

               if yn
               then
                  undo, retry.

               /* DOES STATUS ALLOW TRANSFER INTO RECEIPT SITE */
               {gprun.i ""icedit3.p""
                  "(input ""RCT-TR"",
                    input site,
                    input location,
                    input global_part,
                    input lotserial,
                    input lotref,
                    input lotserial_qty * trans_conv,
                    input trans_um,
                    input pod_nbr,
                    input string(pod_line),
                    output yn)"
                  }
/*GUI*/ if global-beam-me-up then undo, leave.

               if yn
               then
                  undo, retry.
            end. /* if pod_site .. */

         end. /* IF NOT CAN-FIND  */

         find first sr_wkfl
            where sr_userid = mfguser
              and sr_lineid = cline no-error.
         if lotserial_qty = 0
         then do:
            if available sr_wkfl
            then do:
               total_lotserial_qty = total_lotserial_qty - sr_qty.
               delete sr_wkfl.
            end. /* IF AVAILABLE sr_wkfl */
         end. /* IF lotserial_qty = 0 */
         else do:
            if available sr_wkfl
            then
               assign
                  total_lotserial_qty = total_lotserial_qty - sr_qty
                                      + lotserial_qty
                  sr_site             = site
                  sr_loc              = location
                  sr_lotser           = lotserial
                  sr_ref              = lotref
                  sr_qty              = lotserial_qty.
            else do:
               create sr_wkfl.
               assign
                  sr_userid = mfguser
                  sr_lineid = cline
                  sr_site   = site
                  sr_loc    = location
                  sr_lotser = lotserial
                  sr_ref    = lotref
                  sr_qty    = lotserial_qty
                  total_lotserial_qty = total_lotserial_qty
                                      + lotserial_qty.
               if recid(sr_wkfl) = -1
               then .
            end. /* ELSE DO */
         end. /* ELSE DO */
      end.
/*GUI*/ if global-beam-me-up then undo, leave.


      /* FOR BTB CONFIGURED ITEM CREATE STAGE LIST FOR COMPONENTS */
      find sod_det
         where sod_nbr  = po_so_nbr
           and sod_line = pod_sod_line
      no-lock no-error.

      if available sod_det
         and sod_cfg_type = "2"
         and sod_fa_nbr   = ""
      then
         find so_mstr
            where so_nbr = po_so_nbr no-lock no-error.

         if available so_mstr
         then do:

         assign
            deassign  = no
            part_qty  = (total_lotserial_qty * trans_conv).

         /* ADDED SEVENTH INPUT PARAMETER STAGE_OPEN TO SOSKIT01.P  */
         /* REPLACED FOURTH INPUT PARAMETER qty_ratio WITH part_qty */
         /* ADDED FIFTH INPUT PARAMETER (sod_qty_ord - sod_qty_ship)*/

         {gprun.i ""soskit01.p""
            "(input recid(so_mstr),
              input recid(sod_det),
              input deassign,
              input part_qty,
              input (sod_qty_ord - sod_qty_ship),
              input process_type,
              input no,
              input stage_open,
              output yn)"}
/*GUI*/ if global-beam-me-up then undo, leave.

         if yn
         then
            undo, leave.

         /* EXECUTE THE FOLLOWING PART ONLY IF SALES ORDER LINE  IS */
         /* CREATED WITH  KIT PARENT                                */

         for first sr_wkfl
            fields(sr_lineid sr_loc sr_lotser sr_qty
                   sr_ref sr_site sr_userid)
            where sr_userid = mfguser
              and sr_lineid = cline
            no-lock:
         end. /* FOR FIRST sr_wkfl */

         if not available sr_wkfl
         then
            undo, retry  .

         if can-find (first sob_det
            where sob_nbr      = sod_nbr
              and sob_line     = sod_line)
              and sod_fa_nbr   = ""
              and sod_cfg_type <> "1"
              and sod_type     = ""
              and sod_lot      = ""
         then do:

            for first ship_line
               fields (abs_dataset abs_gwt abs_id abs_item abs_line
                       abs_loc abs_lotser abs_nwt abs_order
                       abs_par_id abs_qty abs_ref abs_shipfrom
                       abs_shipto abs_shp_date abs_site abs_type
                       abs_vol abs__qad02 abs__qad03 )
               where ship_line.abs_shipfrom = abs_mstr.abs_shipfrom
                 and ship_line.abs_id      begins ("i" + abs_mstr.abs_id)
                 and ship_line.abs_par_id  begins (abs_mstr.abs_id)
                 and ship_line.abs_item    = pod_part
            no-lock:
            end. /* FOR FIRST ship_line */

            if available ship_line
            then do on error undo mainloop, leave mainloop:

               /* ADDED dir-ship AS NINTH INPUT PARAMETER */
               /* TO INDICATE DIRECT SHIPMENT            */

               run  pgetcomponents (
                 input  sod_nbr ,
                 input  sod_line,
                 input  sr_qty ,
                 input  sr_site,
                 input  sr_loc,
                 input  po_nbr,
                 input  ship_line.abs_shipfrom,
                 input  "i" + abs_mstr.abs_id,
                 input  dir-ship).

            end. /* IF AVAILABLE ship_line */

            else do :
               repeat:
/*GUI*/ if global-beam-me-up then undo, leave.

                  do on error undo,leave :
/*GUI*/ if global-beam-me-up then undo, leave.

                     mod_iss = ?.

                     repeat with frame e:
/*GUI*/ if global-beam-me-up then undo, leave.

                        display l_modiss_lbl mod_iss.
                        display yes @ mod_iss .
                        set mod_iss.
                        leave.
                     end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* REPEAT WITH FRAME E */

                     hide frame e.
                     if mod_iss <> yes
                     then
                        next  mainloop.
                  end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* DO ON ERROR UNDO,LEAVE */

                  if mod_iss = yes
                  then do :

                     /* ADDED dir-ship AS NINTH INPUT PARAMETER */
                     /* TO INDICATE DIRECT SHIPMENT             */

                     run  pgetcomponents  ( input sod_nbr ,
                                            input sod_line,
                                            input sr_qty ,
                                            input sr_site,
                                            input sr_loc,
                                            input po_nbr,
                                            input abs_mstr.abs_shipfrom,
                                            input abs_mstr.abs_id,
                                            input dir-ship).
                  end. /* IF mod_iss = yes */

                  leave .
               end.
/*GUI*/ if global-beam-me-up then undo, leave.
  /* REPEAT */
            end. /* ELSE DO */

            /* DELETE EXISTING QAD_WKFL AND RECREATE QAD_WKFL      */
            /* ON THE BASIS OF SR_WKFL CREATED IN THE ABOVE PROGRAM*/

            for each qad_wkfl exclusive-lock
               where qad_key1 = mfguser + global_db
                                        + "stage_component"
                 and qad_key2 begins sod_nbr + ","  +
                                        string(sod_line) + ","
                 and qad_key3 = sod_nbr
                 and qad_key4 = string(sod_line)
               break by qad_charfld[2]:
               delete qad_wkfl .
            end. /* FOR EACH qad_wkfl */

            for each sr_wkfl exclusive-lock
               where sr_userid = mfguser
                 and sr_lineid begins string(sod_line) + "ISS":

               part = substring(sr_lineid,index(sr_lineid,"ISS")
                                                 + 3,18).
               create qad_wkfl.

               for first pt_mstr
                  fields (pt_part pt_um)
                  where pt_part = part no-lock:
               end. /* FOR FIRST pt_mstr */
               assign
                  qad_key1        = mfguser + global_db
                                            + "stage_component"
                  qad_key2        = sod_nbr + ","
                                            + string(sod_line) + ","
                                            + part             + ","
                                            + sr_site          + ","
                                            + sr_loc           + ","
                                            + sr_lotser        + ","
                                             + sr_ref
                  qad_key3        = sod_nbr
                  qad_key4        = string(sod_line)
                  qad_key5        = string(sod_line)
                  qad_key6        = part
                  qad_decfld[1]   = sr_qty
                  qad_charfld[1]  = sr_site
                  qad_charfld[2]  = part
                  qad_charfld[3]  = sr_loc
                  qad_charfld[4]  = sr_lotser
                  qad_charfld[5]  = sr_ref
                  qad_charfld[6]  = so_ship
                  qad_charfld[7]  = sod_nbr
                  qad_charfld[8]  = string(sod_line)

                  qad_charfld[9]  = ""
                  qad_charfld[10] = if available pt_mstr
                                    then
                                       pt_um
                                    else
                                        ""
                  qad_charfld[11] = "1".
                  delete sr_wkfl.

            end. /* FOR EACH sr_wkfl */

         end. /* IF CAN-FIND sob_det ..  */

         for each qad_wkfl exclusive-lock
         where qad_key1 = mfguser + global_db + "stage_component"
           and qad_key2 begins sod_nbr + "," + string(sod_line) + ","
           and qad_key3 = sod_nbr
           and qad_key4 = string(sod_line)
         break by qad_charfld[2]:
/*GUI*/ if global-beam-me-up then undo, leave.

            /* CHANGED FIRST INPUT PARAMETER FROM ISS-FAS TO */
            /* RCT-FAS TO FACILITATE INVENTORY CHECK  */

            {gprun.i ""icedit.p""
               "(input ""RCT-FAS"",
                 input qad_charfld[1],
                 input qad_charfld[3],
                 input qad_charfld[2],
                 input qad_charfld[4],
                 input qad_charfld[5],
                 input qad_decfld[1],
                 input qad_charfld[10],
                 input """",
                 input """",
                 output yn )"
               }
/*GUI*/ if global-beam-me-up then undo, leave.

            if yn
            then
               undo mainloop, retry mainloop.
         end.
/*GUI*/ if global-beam-me-up then undo, leave.
   /* FOR EACH qad_wkfl   */

      end. /* available so_mstr */

      /* HERE WE DO OUR OVER-RECEIPT TOLERANCE CHECKS */

      if po_fix_rate = no
      then do:
         {gprunp.i "mcpl" "p" "mc-get-ex-rate"
            "(input po_curr,
              input base_curr,
              input "" "",
              input today,
              output exch_rate,
              output exch_rate2,
              output mc-error-number)"}
         if mc-error-number <> 0
         then do:
            /* EXCHANGE RATE DOES NOT EXIST */
            {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=3}
         end.
      end.
      else
         assign
            exch_rate  = po_ex_rate
            exch_rate2 = po_ex_rate2.

      {gprunp.i "mcpl" "p" "mc-curr-conv"
         "(input po_curr,
           input base_curr,
           input exch_rate,
           input exch_rate2,
           input base_amt,
           input false, /* DO NOT ROUND */
           output base_amt,
           output mc-error-number)"}

      total_received = pod_qty_rcvd
                        + (total_lotserial_qty * trans_conv / pod_um_conv).
      if    pod_sched
        or (not pod_sched and
         (total_received > pod_qty_ord and pod_qty_ord > 0) or
         (total_received < pod_qty_ord and pod_qty_ord < 0))
      then do:
         /* Receipt tolerance checking and max order qty */
         {gprun.i ""rsporct.p""
            "(input total_lotserial_qty * trans_conv ,
              input recid(po_mstr),
              input recid(pod_det),
              input abs_mstr.abs_shp_date,
              input poc_tol_pct,
              input poc_tol_cst,
              input base_amt,
              input yes,
              input no,
              output dummy_logi)"}
/*GUI*/ if global-beam-me-up then undo, leave.

      end. /* if pod_sched .. */

   end. /* do with frame a */

   if pod_type = "s"
   then do:
      find wo_mstr where wo_lot = pod_wo_lot no-lock.

      if available wo_mstr and wo_status = "C"
      then do:
         /* WORK ORDER ID IS CLOSED, PLANNED OR FIRM PLANNED */
         {pxmsg.i &MSGNUM=523 &ERRORLEVEL=2}

         /* WORK ORDER ID #, SCHEDULE ORDER # */
         {pxmsg.i &MSGNUM=3069 &ERRORLEVEL=1
                  &MSGARG1="pod_wo_lot" &MSGARG2="pod_nbr"}
     end. /* IF AVAILABLE wo_mstr */

      if wo_type = "c"
      and wo_nbr = ""
      then do:

         find wr_route where wr_lot = pod_wo_lot and wr_op = pod_op no-lock.

         find last prev_wr_route
            where prev_wr_route.wr_lot = wr_route.wr_lot
            and prev_wr_route.wr_op < wr_route.wr_op
         no-lock no-error.

         if available prev_wr_route
         then do:
            {gprun.i ""reiqchg.p""
               "(input wr_route.wr_lot, input wr_route.wr_op,
                 input total_lotserial_qty,
                 output inputq_op, output inputq_qty_chg)"}
/*GUI*/ if global-beam-me-up then undo, leave.


            /*CHECK INPUT QUEUE OF THIS OR THE PRIOR NONMILESTONE OP*/
            {gprun.i ""rechkq.p""
               "(input wr_route.wr_lot,
                 input inputq_op,
                 input ""i"",
                 input inputq_qty_chg,
                 input-output msg_ct)"}
/*GUI*/ if global-beam-me-up then undo, leave.

         end. /* IF AVAILABLE prev_wr_route */
      end. /* IF wo_type = "c" */
   end. /* IF  pod_type =  "s" */

   assign
      old_vol = 0
      old_gwt = 0
      old_nwt = 0.

   update_trans:
   do transaction on error undo mainloop, leave mainloop:
/*GUI*/ if global-beam-me-up then undo, leave.

      /* QUALIFYING ALL FIELDS WITH abs_mstr_item */

      for each abs_mstr_item exclusive-lock
         where abs_mstr_item.abs_shipfrom = abs_mstr.abs_shipfrom
           and abs_mstr_item.abs_par_id   = abs_mstr.abs_id
           and abs_mstr_item.abs_id         begins "i"
           and abs_mstr_item.abs_order    = pod_nbr
           and abs_mstr_item.abs_line     = string(pod_line):

          assign
             old_vol = old_vol + abs_mstr_item.abs_vol.
             old_gwt = old_gwt + abs_mstr_item.abs_gwt.
             old_nwt = old_nwt + abs_mstr_item.abs_nwt.

         /* DELETE OLD KIT COMPONENTS */
         for each abs_comp exclusive-lock
            where abs_comp.abs_shipfrom = abs_mstr_item.abs_shipfrom
              and abs_comp.abs_par_id   = abs_mstr_item.abs_id
              and abs_comp.abs_order    = pod_nbr
              and abs_comp.abs_line     = string (pod_line):
            delete abs_comp.
         end. /* FOR EACH abs_comp */

         delete abs_mstr_item.
      end. /* for each abs_mstr_item */

      i = 0.

      find abs_mstr where recid(abs_mstr) = abs_recid exclusive-lock.

      assign
         new_nwt = 0
         new_gwt = 0
         new_vol = 0.

      for each sr_wkfl exclusive-lock
         where sr_userid = mfguser:
/*GUI*/ if global-beam-me-up then undo, leave.

         i = i + 1.
         create abs_mstr_item.

         /* QUALIFIED ALL FIELDS WITH abs_mstr_item. */

         assign
            abs_mstr_item.abs_shipfrom = abs_mstr.abs_shipfrom
            abs_mstr_item.abs_id       = "i" + abs_mstr.abs_id +
                                               string(pod_nbr,"x(8)") +
                                               string(pod_line,"9999")
                                             + string(i,"9999")
            abs_mstr_item.abs_par_id   = abs_mstr.abs_id
            abs_mstr_item.abs_item     = pod_part
            abs_mstr_item.abs_site     = sr_site
            abs_mstr_item.abs_loc      = sr_loc
            abs_mstr_item.abs_lotser   = sr_lotser
            abs_mstr_item.abs_ref      = sr_ref
            abs_mstr_item.abs_qty      = sr_qty
            abs_mstr_item.abs_dataset  = "pod_det"
            abs_mstr_item.abs_order    = pod_nbr
            abs_mstr_item.abs_line     = string(pod_line)
            abs_mstr_item.abs_type     = "r"
            l_id                       =  abs_mstr.abs_id
            l_shipfrom                 =  abs_mstr.abs_shipfrom .

         if recid(abs_mstr_item) = -1
         then .

         /*  ADD ABS RECORDS FOR KIT COMPONENTS */
         if available sod_det
           and can-find (first sob_det
                            where sob_nbr  = po_so_nbr
                              and sob_line = pod_sod_line)
         then do:
            qty_ratio = sr_qty / total_lotserial_qty.

            /* SET qty_ratio = 1 FOR KIT PARENT ITEM */
            if sod_cfg_type = "2"
            then
               qty_ratio = 1.

            /* QUALIFIED FOURTH INPUT PARAMETER WITH abs_mstr_item */

            {gprun.i ""rcshwbc3.p""
               "(input recid (abs_mstr_item),
                 input recid (sod_det),
                 input qty_ratio,
                 input abs_mstr_item.abs_qty ,
                 input sr_site,
                 input sr_loc,
                 input sr_lotser,
                 input sr_ref,
                 input "no")"}
/*GUI*/ if global-beam-me-up then undo, leave.


         end. /* IF AVAILABLE sod_det */

         /* CALL GPICLT.P TO CHECK FOR AND ADD THE LOT/SERIAL */
         /* TO LOT_MSTR */

         /*  CREATE LOT_MSTR RECORDS for components */

         for each abs_buff no-lock
            where abs_buff.abs_shipfrom   = l_shipfrom
              and abs_buff.abs_id begins ("i" + l_id )
         use-index abs_id:
/*GUI*/ if global-beam-me-up then undo, leave.


            if  (clc_lotlevel <> 0)
            and (abs_lotser   <> "")
            then do:
               {gprun.i ""gpiclt.p"" "(input abs_item,
                                       input abs_buff.abs_lotser,
                                       input abs_buff.abs_order,
                                       input string(abs_buff.abs_line),
                                       output trans-ok)" }
/*GUI*/ if global-beam-me-up then undo, leave.



               if not trans-ok
               then do:
                  /* CURRENT TRANSACTION REJECTED --  */
                  /* CONTINUE WITH NEXT TRANSACTION   */
                  {pxmsg.i &MSGNUM=2740 &ERRORLEVEL=4}
                  undo, next.
               end. /* IF NOT TRANS-OK THEN DO: */
            end. /* IF clc_lotlev <> 0 ... */
         end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* FOR EACH abs_buff ..  */

         assign
            abs_mstr_item.abs__qad02 = trans_um
            abs_mstr_item.abs__qad03 = string(trans_conv).

         delete sr_wkfl.
      end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* FOR EACH sr_wkfl */

   end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* DO TRANS  .. */

   /* DELETE qad_wkfl for components*/
   if available sod_det
   and sod_cfg_type = "2"
   then do:
      {gprun.i ""rcshwbc4.p"" "(input recid (sod_det))"}
/*GUI*/ if global-beam-me-up then undo, leave.

   end.

   for each sr_wkfl exclusive-lock
      where sr_userid = mfguser:
      delete sr_wkfl.
   end. /* FOR EACH sr_wkfl */

   for each qad_wkfl exclusive-lock where
      qad_key1 = mfguser + "rsshmtb.p":
      delete qad_wkfl.
   end. /* FOR EACH qad_wkfl */

   for each uom_abs exclusive-lock:
      delete uom_abs.
   end. /* FOR EACH uom_abs */

end.  /* REPEAT */
hide frame a.

/* PROCEDURE TO ADD/MODIFY COMPONENTS */

PROCEDURE pgetcomponents:
   define input parameter l_sod_nbr      like sod_nbr              no-undo.
   define input parameter l_sod_line     like sod_line             no-undo.
   define input parameter l_sr_qty       like sr_qty               no-undo.
   define input parameter l_sr_site      like sr_site              no-undo.
   define input parameter l_sr_loc       like sr_loc               no-undo.
   define input parameter l_po_nbr       like po_nbr               no-undo.
   define input parameter l_abs_shipfrom like abs_shipfrom         no-undo.
   define input parameter l_abs_id       like abs_id               no-undo.
   define input parameter dir-ship       like mfc_logical          no-undo.

   l_old_db = global_db.
   for first si_mstr
      fields(si_db si_site)
      where si_site = l_sr_site
   no-lock:
   end. /* FOR FIRST si_mstr */
   if    available si_mstr
     and si_db <> global_db
   then do:
      {gprun.i ""gpalias3.p"" "(si_db, output l_err-flag)" }
/*GUI*/ if global-beam-me-up then undo, leave.

   end. /* IF AVAILABLE si_mstr ... */

   /* ADDED dir-ship AS 9TH PARAMETER */
   /* TO INDICATE DIRECT SHIPMENT      */

   {gprun.i ""rsshmt01.p""
      "(l_sod_nbr,
        l_sod_line,
        l_sr_qty,
        l_sr_site,
        l_sr_loc,
        l_po_nbr,
        l_abs_shipfrom,
        l_abs_id,
        dir-ship)"}
/*GUI*/ if global-beam-me-up then undo, leave.


   if l_old_db <> global_db
   then do:
      {gprun.i ""gpalias3.p"" "(l_old_db, output l_err-flag)" }
/*GUI*/ if global-beam-me-up then undo, leave.

  end. /* IF l_old_db <> global_db */

END PROCEDURE.
